home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / m2gem106.lzh / CRYSTAL1.06 / SRC / TOOLBOX / GRAFTOOL.MOD < prev    next >
Encoding:
Modula Implementation  |  1994-01-25  |  11.3 KB  |  477 lines
  1. IMPLEMENTATION MODULE GrafTool;
  2.  
  3. (*
  4. Grafics Tools.
  5.  
  6. UK __DATE__ __TIME__
  7. *)
  8.  
  9. (*IMP_SWITCHES*)
  10.  
  11. FROM AES        IMPORT TreePtr,Selectable,Selected,ObjectState,Root,Nil,
  12.                        ObjectPtr,ObjectIndex;
  13. FROM EvntMgr    IMPORT MEvent,EvntEvent,MuButton,MuM1,MuTimer,Event,
  14.                        MouseButton,MBLeft,MoExit;
  15. FROM GrafMgr    IMPORT GrafMouse,MOn,MOff,UserDef,MFormPtr,MForm,
  16.                        GrafRubberBox,GrafMKState,SpecialKey;
  17. FROM ObjcMgr    IMPORT ObjcFind,ObjcChange;
  18. FROM WindMgr    IMPORT WindUpdate,BegMCtrl,EndMCtrl,WindFind;
  19. FROM RcMgr      IMPORT GRect,GPnt,RcConstrain,RcInside,Max,Min;
  20. FROM VAttribute IMPORT VSWrMode,MdXOR,VSLColor,VSLUDSty,
  21.                        VSLType,LTSolid,LTUserDef;
  22. FROM VOutput    IMPORT XY,VPLine;
  23. FROM ObjcTool   IMPORT DrawWindowObject;
  24. FROM VDITool    IMPORT OpenVWork,CloseVWork,GBoxToArray;
  25. FROM PORTAB     IMPORT UNSIGNEDWORD,SIGNEDWORD,NULL,WORDSET;
  26. FROM INTRINSIC  IMPORT INCPTR,PTR;
  27. FROM pSTORAGE   IMPORT ALLOCATE,DEALLOCATE;
  28. FROM SYSTEM     IMPORT TSIZE;
  29. CAST_IMPORT
  30.  
  31. IMPORT VDI,SetObject,GetObject;
  32.  
  33. #if no_local_modules
  34.  
  35. #else
  36.   MODULE MouseFormRoutines;
  37.  
  38.   IMPORT MFormPtr,MForm,UserDef,GrafMouse,NULL,
  39.          MouseColors,MouseData,UNSIGNEDWORD,SIGNEDWORD,
  40.          ALLOCATE,DEALLOCATE,MouseForms,TSIZE;
  41.  
  42.   EXPORT SetMouse,NewMouse,DisposeMouse,MouseForm,UserMouse,LastMouse;
  43. #endif
  44.   VAR ActualForm: UNSIGNEDWORD;
  45.       LastForm  : UNSIGNEDWORD;
  46.  
  47.       ActualAddress: MFormPtr;
  48.       LastAddress  : MFormPtr;
  49.  
  50.   PROCEDURE SetMouse(Number: UNSIGNEDWORD; Addr: MFormPtr);
  51.   BEGIN
  52.     LastForm:= ActualForm;
  53.     LastAddress:= ActualAddress;
  54.  
  55.     ActualForm:= Number;
  56.     ActualAddress:= Addr;
  57.  
  58.     IF (ActualForm # LastForm) OR (ActualAddress # LastAddress) THEN
  59.       GrafMouse(Number,Addr);
  60.     END;
  61.   END SetMouse;
  62.  
  63.   PROCEDURE NewMouse(    XHotSpot  : UNSIGNEDWORD;
  64.                          YHotSpot  : UNSIGNEDWORD;
  65.                          ForeGround: MouseColors;
  66.                          BackGround: MouseColors;
  67.                      VAR Mask      : MouseData;
  68.                      VAR Data      : MouseData): MFormPtr;
  69.  
  70.   VAR MyMouse: MFormPtr;
  71.       i      : [0..15];
  72.  
  73.   BEGIN
  74.     ALLOCATE(MyMouse,TSIZE(MForm));
  75.     IF MyMouse # NIL THEN
  76.       WITH MyMouse^ DO
  77.         MFXHot:= XHotSpot;
  78.         MFYHot:= YHotSpot;
  79.         MFNPlanes:= 1;
  80.         MFFG:= ForeGround;
  81.         MFBG:= BackGround;
  82.         FOR i:= 0 TO 15 DO
  83.           MFMask[i]:= Mask[i];
  84.           MFData[i]:= Data[i];
  85.         END;
  86.       END;
  87.       SetMouse(UserDef,MyMouse);
  88.     END;
  89.     RETURN MyMouse;
  90.   END NewMouse;
  91.  
  92.   PROCEDURE DisposeMouse(VAR Form: MFormPtr);
  93.   BEGIN
  94.     DEALLOCATE(Form,TSIZE(MForm));
  95.   END DisposeMouse;
  96.  
  97.   PROCEDURE UserMouse(UserDefForm: MFormPtr);
  98.   BEGIN
  99.     SetMouse(UserDef,UserDefForm);
  100.   END UserMouse;
  101.  
  102.   PROCEDURE MouseForm(Form: MouseForms);
  103.   BEGIN
  104.     SetMouse(ORD(Form),NULL);
  105.   END MouseForm;
  106.  
  107.   PROCEDURE LastMouse;
  108.   BEGIN
  109.     SetMouse(LastForm,LastAddress);
  110.   END LastMouse;
  111. #if no_local_modules
  112.  
  113. #else
  114.   BEGIN
  115.     ActualAddress:= NULL;
  116.     LastAddress:= NULL;
  117.  
  118.     ActualForm:= ORD(Arrow);
  119.     LastForm:= ORD(Arrow);
  120.   END MouseFormRoutines;
  121.  
  122.   MODULE ShowAndHideMouse;
  123.  
  124.   IMPORT GrafMouse,MOn,MOff,NULL;
  125.   EXPORT ShowMouse,HideMouse;
  126. #endif
  127.   VAR Hidden: BOOLEAN;
  128.  
  129.   PROCEDURE ShowMouse;
  130.   BEGIN
  131.     IF Hidden THEN
  132.       GrafMouse(MOn,NULL);
  133.     END;
  134.     Hidden:= FALSE;
  135.   END ShowMouse;
  136.  
  137.   PROCEDURE HideMouse;
  138.   BEGIN
  139.     IF NOT Hidden THEN
  140.       GrafMouse(MOff,NULL);
  141.     END;
  142.     Hidden:= TRUE;
  143.   END HideMouse;
  144. #if no_local_modules
  145.  
  146. #else
  147.   BEGIN
  148.     Hidden:= FALSE;
  149.   END ShowAndHideMouse;
  150.  
  151.   MODULE BusyOrArrow;
  152.  
  153.   IMPORT BusyBee,Arrow,MouseForm;
  154.   EXPORT BusyMouse,ArrowMouse;
  155. #endif
  156.   PROCEDURE BusyMouse;
  157.   BEGIN
  158.     MouseForm(BusyBee);
  159.   END BusyMouse;
  160.  
  161.   PROCEDURE ArrowMouse;
  162.   BEGIN
  163.     MouseForm(Arrow);
  164.   END ArrowMouse;
  165. #if no_local_modules
  166.  
  167. #else
  168.   END BusyOrArrow;
  169. #endif
  170.  
  171. PROCEDURE GetMouse(VAR Pos: GPnt);
  172.  
  173. VAR MState: MouseButton;
  174.     KState: SpecialKey;
  175.  
  176. BEGIN
  177.   GrafMKState(Pos,MState,KState);
  178. END GetMouse;
  179.  
  180. PROCEDURE RubberBox(Start: GPnt; VAR Box: GRect);
  181. BEGIN
  182.   Box.GX:= Start.GX;
  183.   Box.GY:= Start.GY;
  184.  
  185.   MouseForm(PointingHand);
  186.   GrafRubberBox(Start,-32767,-32767,Box.GW,Box.GH); (* works with PC-GEM too *)
  187.   LastMouse;
  188.  
  189.   WITH Box DO
  190.    IF GW < 0 THEN
  191.      INC(GX,GW);
  192.      GW:= -GW;
  193.    END;
  194.    IF GH < 0 THEN
  195.      INC(GY,GH);
  196.      GH:= -GH;
  197.    END;
  198.  END;
  199. END RubberBox;
  200.  
  201. (*
  202. PROCEDURE GrafRubberBox(VAR StartPos   : GPnt;
  203.                             StartWidth : SIGNEDWORD;
  204.                             StartHeight: SIGNEDWORD;
  205.                         VAR LastWidth  : SIGNEDWORD;
  206.                         VAR LastHeight : SIGNEDWORD);
  207.  
  208. VAR Box: GRect;
  209.  
  210. BEGIN
  211.   RubberBox(StartPos,Box);
  212.   StartPos.GX:= Box.GX;
  213.   StartPos.GY:= Box.GY;
  214.   LastWidth:= Box.GW;
  215.   LastHeight:= Box.GH;
  216. END GrafRubberBox;
  217. *)
  218.  
  219. #if no_local_modules
  220.  
  221. #else
  222.   MODULE Dragging;
  223.  
  224.   IMPORT TreePtr,Selectable,Selected,ObjectState,Root,Nil,ObjectPtr,
  225.          ObjectIndex,
  226.          MEvent,EvntEvent,MuButton,MuM1,MuTimer,Event,MouseButton,MBLeft,
  227.          MoExit,
  228.          ObjcFind,ObjcChange,
  229.          WindUpdate,BegMCtrl,EndMCtrl,WindFind,
  230.          GRect,GPnt,RcConstrain,RcInside,Max,Min,
  231.          VSWrMode,MdXOR,VSLColor,VSLUDSty,VSLType,LTSolid,LTUserDef,
  232.          XY,VPLine,
  233.          DrawWindowObject,
  234.          OpenVWork,CloseVWork,GBoxToArray,
  235.          UNSIGNEDWORD,SIGNEDWORD,WORDSET,
  236.          INCPTR,PTR,
  237. #if (defined MM2) || (defined HM2) || (defined GPM2)
  238.          CAST,
  239. #endif
  240.          ShowMouse,HideMouse,GetMouse,
  241.          VDI,SetObject,GetObject;
  242.  
  243.   EXPORT HotDragBox;
  244. #endif
  245.   VAR HztlTbl: ARRAY[0..1] OF UNSIGNEDWORD;
  246.       VertTbl: ARRAY[0..3] OF UNSIGNEDWORD;
  247.  
  248.   PROCEDURE VDIXLine(Handle: UNSIGNEDWORD; PtsCount: UNSIGNEDWORD; VAR Points: ARRAY OF XY);
  249.  
  250.   VAR Style : UNSIGNEDWORD;
  251.       i     : UNSIGNEDWORD;
  252.       x     : UNSIGNEDWORD;
  253.       LineXY: XY;
  254.       Line  : ARRAY[0..3] OF XY;
  255.       PLine : POINTER TO ARRAY[0..3] OF XY;
  256.  
  257.   BEGIN
  258.     x:= 0;
  259.  
  260.     (*
  261.     PLine:= PTR(Points);
  262.     *)
  263.  
  264.     FOR i:= 1 TO (PtsCount - 1) DO
  265.     (*IF Points^[0] = Points^[2] THEN*)
  266.       IF Points[x] = Points[x+2] THEN
  267. #ifdef HM2
  268.         Style:= VertTbl[CAST(UNSIGNEDWORD,VAL(WORDSET,ORD(ODD(Points[x]))) +
  269.                                           VAL(WORDSET,(ORD(ODD(Points[x+1]))*2)))];
  270. #else
  271.         Style:= VertTbl[CAST(UNSIGNEDWORD,CAST(WORDSET,ORD(ODD(Points[x]))) +
  272.                                           CAST(WORDSET,(ORD(ODD(Points[x+1]))*2)))];
  273. #endif
  274.       ELSE
  275.         IF Points[x] < Points[x+2] THEN
  276.       (*IF Points^[0] < Points^[2] THEN*)
  277.           LineXY:= Points[x+1];
  278.         ELSE
  279.           LineXY:= Points[x+3];
  280.         END;
  281.         Style:= HztlTbl[ORD(ODD(LineXY))];
  282.       END;
  283.  
  284.       VSLUDSty(Handle,Style);
  285.       VSLType(Handle,LTUserDef);
  286.       Line[0]:= Points[x];
  287.       Line[1]:= Points[x+1];
  288.       Line[2]:= Points[x+2];
  289.       Line[3]:= Points[x+3];
  290.       VPLine(Handle,2,Line);
  291.     (*VPLine(Handle,2,Points^);*)
  292.       INC(x,2); (*INCPTR(PLine,4 (* 2 * TSIZE(XY) *) );*)
  293.     END;
  294.  
  295.     VSLType(Handle,LTSolid);
  296.   END VDIXLine;
  297.  
  298.   PROCEDURE HotDragBox(VAR Pos  : GPnt;
  299.                        VAR Box  : GRect;
  300.                            Limit: GRect;
  301.                            Tree : TreePtr): ObjectPtr;
  302.  
  303.   VAR Handle : UNSIGNEDWORD;
  304.       Window : SIGNEDWORD;
  305.       PXY    : ARRAY[0..9] OF XY;
  306.       Which  : Event;
  307.       MyEvent: MEvent;
  308.       Dummy  : BOOLEAN;
  309.       OldXY  : GPnt;
  310.       HotOb  : ObjectPtr;
  311.       Return : ObjectPtr;
  312.  
  313.     PROCEDURE ToggleObject(Tree  : TreePtr;
  314.                            Index : ObjectIndex);
  315.                          (*Window: SIGNEDWORD*)
  316.     VAR Rect: GRect;
  317.  
  318.     BEGIN
  319.       SetObject.State(Tree,
  320.                       Index,
  321.                       GetObject.State(Tree,Index) / ObjectState{Selected});
  322.       DrawWindowObject(Window,Tree,Index);
  323.     END ToggleObject;
  324.  
  325.   BEGIN
  326.     HotOb:= Nil;
  327.  
  328.     IF OpenVWork(Handle) THEN
  329.       VSWrMode(Handle,MdXOR);
  330.       VSLColor(Handle,VDI.Black);
  331.  
  332.       Dummy:= WindUpdate(BegMCtrl);
  333.  
  334.       MyEvent.EMXY:= Pos; (* initialise with actual position *)
  335.  
  336.       Window:= WindFind(Pos);
  337.  
  338.       WITH OldXY DO
  339.         GX:= Min(Box.GW,Max(0,MyEvent.EMXY.GX - Box.GX));
  340.         GY:= Min(Box.GH,Max(0,MyEvent.EMXY.GY - Box.GY));
  341.       END;
  342.  
  343.       WITH MyEvent DO
  344.         EFlags:= Event{MuButton,MuM1,MuTimer};
  345.         EBClk:= 1;
  346.         EBMsk:= MouseButton{MBLeft};
  347.         EBSt:= MouseButton{};
  348.         EM1Flags:= MoExit;
  349.         EM1.GX:= EMXY.GX;
  350.         EM1.GY:= EMXY.GY;
  351.         EM1.GW:= 1;
  352.         EM1.GH:= 1;
  353.         ELoCount:= 125;
  354.         EHiCount:= 0;
  355.       END;
  356.  
  357.       Which:= Event{MuM1}; (* initialise for first drawing *)
  358.  
  359.       REPEAT
  360.         WITH Box DO
  361.           GX:= MyEvent.EMXY.GX - OldXY.GX;
  362.           GY:= MyEvent.EMXY.GY - OldXY.GY;
  363.         END;
  364.  
  365.         RcConstrain(Limit,Box); (* lock into limit rect *)
  366.  
  367.         IF (MuM1 IN Which) THEN
  368.           HideMouse;
  369.           GBoxToArray(Box,PXY);
  370.           VDIXLine(Handle,5,PXY);
  371.           ShowMouse;
  372.         END;
  373.  
  374.         Which:= EvntEvent(MyEvent);
  375.  
  376.         WITH MyEvent DO
  377.           EM1.GX:= EMXY.GX;
  378.           EM1.GY:= EMXY.GY;
  379.         END;
  380.  
  381.         IF (MuM1 IN Which) THEN
  382.           HideMouse;
  383.           GBoxToArray(Box,PXY);
  384.           VDIXLine(Handle,5,PXY);
  385.           ShowMouse;
  386.         END;
  387.  
  388.         IF NOT RcInside(MyEvent.EMXY,Limit) THEN
  389.           Return:= Nil;
  390.         ELSE
  391.           Return:= ObjcFind(Tree,Root,1,MyEvent.EMXY);
  392.  
  393.           IF Return # Nil THEN
  394.             IF NOT(Selectable IN GetObject.Flags(Tree,Return)) THEN
  395.               Return:= Nil;
  396.             END;
  397.           END;
  398.         END;
  399.  
  400.         IF Return # HotOb THEN
  401.  
  402.           IF (HotOb # Nil) THEN
  403.             ToggleObject(Tree,HotOb);
  404.           END;
  405.  
  406.           HotOb:= Return;
  407.  
  408.           IF (HotOb # Nil) THEN
  409.             IF NOT(Selected IN GetObject.State(Tree,HotOb)) THEN
  410.               ToggleObject(Tree,HotOb);
  411.             END;
  412.           END;
  413.  
  414.         END;
  415.  
  416.       UNTIL (MuButton IN Which); (* until button up *)
  417.  
  418.       Dummy:= WindUpdate(EndMCtrl); (* release mouse to GEM *)
  419.  
  420.       IF (HotOb # Nil) AND
  421.           NOT(Selected IN GetObject.State(Tree,Return)) THEN
  422.         ToggleObject(Tree,HotOb);
  423.       END;
  424.  
  425.       IF NOT(MuM1 IN Which) THEN
  426.         HideMouse;
  427.         GBoxToArray(Box,PXY);
  428.         VDIXLine(Handle,5,PXY);
  429.         ShowMouse;
  430.       END;
  431.  
  432.       Pos.GX:= Box.GX;
  433.       Pos.GY:= Box.GY;
  434.  
  435.       CloseVWork(Handle);
  436.     END;
  437.  
  438.     RETURN HotOb;
  439.   END HotDragBox;
  440. #if no_local_modules
  441.  
  442. #else
  443.   BEGIN
  444.     HztlTbl[0]:= 05555H;
  445.     HztlTbl[1]:= 0AAAAH;
  446.     VertTbl[0]:= 05555H;
  447.     VertTbl[1]:= 0AAAAH;
  448.     VertTbl[2]:= 0AAAAH;
  449.     VertTbl[3]:= 05555H;
  450.   END Dragging;
  451. #endif
  452.  
  453. #if no_local_modules
  454. BEGIN
  455.   (* from local module MouseFormRoutines *)
  456.  
  457.   ActualAddress:= NULL;
  458.   LastAddress:= NULL;
  459.  
  460.   ActualForm:= ORD(Arrow);
  461.   LastForm:= ORD(Arrow);
  462.  
  463.   (* from local module ShowAndHideMouse *)
  464.  
  465.   Hidden:= FALSE;
  466.  
  467.   (* from local module Dragging *)
  468.  
  469.   HztlTbl[0]:= 05555H;
  470.   HztlTbl[1]:= 0AAAAH;
  471.   VertTbl[0]:= 05555H;
  472.   VertTbl[1]:= 0AAAAH;
  473.   VertTbl[2]:= 0AAAAH;
  474.   VertTbl[3]:= 05555H;
  475.  
  476. #endif
  477. END GrafTool.